home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / SCIENTIF / 0428.ZIP / NMR5.BAS < prev    next >
BASIC Source File  |  1985-04-19  |  10KB  |  229 lines
  1. 1 'NMR5--Part 5 of NMRCALC package.  Plotting routines.
  2. 10 DEFINT I-N
  3. 15 'COMMON IPFLAG,IREAD,FF$
  4. 16 OPEN "scratch.nmr" FOR INPUT AS 1
  5. 17 INPUT #1, IPFLAG: INPUT #1, IREAD: LINE INPUT #1, FF$
  6. 18 CLOSE #1
  7. 20 DIM PL(639),BC(7),SLINES(3003,2)
  8. 25 DIM PLP(639),IPL(639)
  9. 27 SCREEN 0,0,0:COLOR 14,4,1:KEY OFF:CLS
  10. 30 CLS:PRINT:PRINT"Routine for plotting spectra as either stick plots or as Lorentzians.":PRINT:PRINT"Be sure to read in the data files if auto-read not in effect!": GOSUB 63999
  11. 35 ON ERROR GOTO 60000
  12. 40 DELNU = .5: ITFLAG = 0: IRFLAG = 0
  13. 50 HF = .8: FRAC = .001: YSCALE = 172
  14. 55 SCREEN 0: COLOR 14,4,1: CLS: KEY OFF
  15. 60 IF IREAD=1 THEN GOSUB 2020
  16. 100 SCREEN 0,0,0:COLOR 14,4,1: CLS: PRINT:PRINT"Enter command ('ME' for menu): ";: GOSUB 500
  17. 105 IF PP$ = "FF" THEN LPRINT CHR$(12);
  18. 110 IF PP$ = "ME" THEN GOSUB 1000
  19. 112 IF PP$ = "QE" THEN GOSUB 900: CHAIN "nmr6"
  20. 115 IF PP$ = "DR" THEN GOSUB 11000
  21. 120 IF PP$ = "RD" THEN GOSUB 2000
  22. 125 IF PP$ = "EP" THEN GOSUB 900: CHAIN "nmr6"
  23. 130 IF PP$ = "SP" THEN GOSUB 3000
  24. 135 IF PP$ = "FT" THEN GOSUB 20000
  25. 140 IF PP$ = "LP" THEN GOSUB 4000
  26. 150 IF PP$ = "HF" THEN GOSUB 5000
  27. 160 IF PP$ = "LF" THEN GOSUB 6000
  28. 170 IF PP$ = "VG" THEN GOSUB 7000
  29. 175 IF PP$ = "TI" THEN GOSUB 10000
  30. 180 IF PP$ = "NH" THEN GOSUB 9000
  31. 190 IF PP$ = "QM" THEN GOSUB 900: CHAIN "NMR1"
  32. 195 IF PP$ = "QL" THEN GOSUB 900: CHAIN "nmr4"
  33. 196 IF PP$ = "QT" THEN CLS: PRINT:PRINT"End of run.  Returning control to system.": END
  34. 200 GOTO 100
  35. 500 P1$ = INKEY$: IF P1$ = "" THEN 500
  36. 510 IF ASC(P1$) > 90 THEN P1$ = CHR$(ASC(P1$) - 32)
  37. 515 PRINT P1$;
  38. 520 P2$ = INKEY$: IF P2$ = "" THEN 520
  39. 530 IF ASC(P2$) > 90 THEN P2$ = CHR$(ASC(P2$) - 32)
  40. 535 PRINT P2$
  41. 540 PP$ = P1$ + P2$
  42. 550 RETURN
  43. 600 P$ = INKEY$: IF P$ = "" THEN 600
  44. 610 IF ASC(P$) > 90 THEN P$ = CHR$(ASC(P$) - 32)
  45. 620 PRINT P$
  46. 630 RETURN
  47. 700 BEEP:PRINT:PRINT"Illegal range.  Check values of upper and lower frequencies.": GOTO 63999
  48. 900 OPEN "scratch.nmr" FOR OUTPUT AS 1
  49. 910 PRINT #1, IPFLAG: PRINT #1, IREAD: PRINT #1, FF$
  50. 920 CLOSE #1
  51. 930 RETURN
  52. 1000 CLS:PRINT:PRINT"Menu of available options--":PRINT
  53. 1002 PRINT"'DR'--Display ranges on plot (control of option to request this)."
  54. 1004 PRINT"'EP'--Exit to energy level (or Fz level) plotting routines."
  55. 1005 PRINT"'FF'--Send form feed to printer (used after a printer plot)."
  56. 1006 PRINT"'FT'--Dump plot to disk for use by FFT program (1K transform)."
  57. 1010 PRINT"'HF'--Set high (left) frequency limit of plot."
  58. 1020 PRINT"'LF'--Set low frequency (right) limit of plot."
  59. 1030 PRINT"'LP'--Do a Lorentzian plot (sets linewidth)."
  60. 1040 PRINT"'ME'--Display this menu."
  61. 1050 PRINT"'NH'--Redo Lorentzian plot with new vertical scale."
  62. 1052 PRINT"'QE'--Exit to energy level plotting routine (NMR6)."
  63. 1055 PRINT"'QL'--Chain back to listing routine (NMR4)"
  64. 1056 PRINT"'QM'--Chain back to main I/O routine (NMR1)"
  65. 1060 PRINT"'QT'--Exit and return control to system."
  66. 1070 PRINT"'RD'--Read spectrum line file.  This must be done before plotting!"
  67. 1080 PRINT"'SP'--Do a stick plot of spectrum."
  68. 1085 PRINT"'TI'--Puts a title on bottom of plot."
  69. 1090 PRINT"'VG'--Set vertical gain for normalization."
  70. 1100 PRINT:INPUT"Hit <Return> to continue.", A$: RETURN
  71. 2000 CLS:PRINT:PRINT"Ready to enter in spectrum lines.  Data set name needed? ";: GOSUB 600: IF P$ = "N" THEN 2020 ELSE IF P$ <> "Y" THEN 2000
  72. 2010 PRINT:INPUT"Enter data set name: ",FF$
  73. 2020 DF$ = FF$ + ".inf": OPEN DF$ FOR INPUT AS 1
  74. 2025 PRINT:PRINT"Reading in file ";DF$
  75. 2030 INPUT #1,NS: INPUT #1,NL
  76. 2040 FOR I = 0 TO NS: INPUT #1, BC(I): NEXT
  77. 2050 CLOSE 1
  78. 2051 DF$ = FF$ + ".0": OPEN DF$ FOR INPUT AS 1
  79. 2052 PRINT:PRINT"Getting spectrometer frequency."
  80. 2053 INPUT #1, NULL: INPUT #1, FR
  81. 2054 CLOSE 1
  82. 2055 FU = 10*FR: FL = 0
  83. 2059 NL = 0
  84. 2060 FOR I = 1 TO NS: NL = NL + BC(I-1)*BC(I): NEXT
  85. 2070 PRINT:PRINT NS;"spins": PRINT NL;"transitions": PRINT: DF$ = FF$ + ".lin":       OPEN DF$ FOR INPUT AS 1
  86. 2075 PRINT:PRINT"Reading in file ";DF$
  87. 2080 FOR I = 1 TO NL: FOR J = 0 TO 2: INPUT #1, SLINES(I,J): NEXT: NEXT
  88. 2090 CLOSE 1
  89. 2100 PRINT"Spectrum lines now loaded.": GOTO 63999
  90. 3000 IF FL > FU THEN 700 ELSE CLS:PRINT:PRINT "Now producing stick plot. Please stand by.":PRINT:PRINT"After plot completed, hit any key to get back to command mode and text screen.":PRINT
  91. 3005 LFLAG = 0
  92. 3010 GOSUB 3900
  93. 3020 FOR I = 1 TO NL
  94. 3025 PLINE = SLINES(I,1): IF PLINE > FU OR PLINE < FL THEN 3050
  95. 3030 IP = INT(RM*(PLINE - FU)): IF IP < 0 OR IP > 639 THEN 3050
  96. 3040 PL(IP) = PL(IP) + SLINES(I,2)
  97. 3050 NEXT
  98. 3060 GOSUB 8000
  99. 3070 FOR I = 0 TO 639: PL(I) = HF*PL(I)/X: NEXT
  100. 3075 IF LFLAG = 1 THEN RETURN
  101. 3080 GOSUB 3800
  102. 3090 FOR I = 0 TO 639
  103. 3100 IY = INT(YSCALE*(1 - PL(I))): IF IY < 0 THEN IY = 0
  104. 3110 IF IY < YSCALE THEN LINE (I,YSCALE)-(I,IY)
  105. 3120 NEXT
  106. 3125 IF ITFLAG THEN LOCATE 24,2:  PRINT TITLE$;
  107. 3127 IF IRFLAG THEN GOSUB 11500
  108. 3130 BEEP
  109. 3140 A$ = INKEY$: IF A$ = "" THEN 3140
  110. 3145 IF ITFLAG OR IRFLAG THEN PRINT
  111. 3150 RETURN
  112. 3800 SCREEN 0: SCREEN 2: OUT 985,14: LINE(0,0)-(639,199),,B: RETURN
  113. 3900 RM = 639/(FL - FU)
  114. 3910 PRINT:PRINT"Resolution: "; -1/RM;"Hz": PRINT
  115. 3920 FOR I = 0 TO 639: PL(I) = 0: NEXT
  116. 3930 RETURN
  117. 4000 IF FL > FU THEN 700 ELSE CLS:PRINT:PRINT"Routine to produce Lorentzian plot.":PRINT
  118. 4010 PRINT"Current linewidth: ";DELNU:PRINT: LFLAG = 1
  119. 4020 PRINT:INPUT"Enter new linewidth (or hit <Return> to keep old): ",DELNUTEMP
  120. 4030 IF DELNUTEMP > 0 THEN DELNU = DELNUTEMP
  121. 4040 GOSUB 3900
  122. 4050 RW = -2/(DELNU*RM)
  123. 4060 PRINT"This may take a while.  To pass the time, things will be displayed on the":PRINT" screen as they are generated.": PRINT:PRINT"After plot completed, hit any key to resume with text screen.": GOSUB 63999
  124. 4070 GOSUB 3800
  125. 4080 GOSUB 3020: LFLAG = 0
  126. 4090 INDEX = 0
  127. 4100 FOR I = 0 TO 639
  128. 4110 IF PL(I) > 0 THEN INDEX = INDEX + 1: IPL(INDEX) = I: PLP(INDEX) = PL(I)
  129. 4120 NEXT
  130. 4125 GOSUB 8000: PMIN = FRAC*X
  131. 4130 FOR I = 0 TO 639: PL(I) = 0: NEXT
  132. 4140 FOR I = 1 TO INDEX
  133. 4150 IPL = IPL(I): PLP = PLP(I)
  134. 4155 PSET(IPL,YSCALE*(1-PLP)): PL(IPL) = PL(IPL) + PLP
  135. 4160 J = IPL
  136. 4162 J = J + 1: IF J > 639 THEN 4170
  137. 4164 PLJ = PLP/(1 + (RW*(J - IPL))^2): IF PLJ < PMIN THEN 4170
  138. 4166 PL(J) = PL(J) + PLJ: PSET (J,YSCALE*(1-PLJ))
  139. 4168 GOTO 4162
  140. 4170 J = IPL
  141. 4172 J = J -1: IF J < 0 THEN 4200
  142. 4174 PLJ = PLP/(1 + (RW*(J - IPL))^2): IF PLJ < PMIN THEN 4200
  143. 4176 PL(J) = PL(J) + PLJ: PSET (J,YSCALE*(1-PLJ))
  144. 4178 GOTO 4172
  145. 4200 NEXT
  146. 4210 GOSUB 8000
  147. 4220 FOR I = 0 TO 639: PL(I) = HF*PL(I)/X: NEXT
  148. 4230 GOSUB 3800
  149. 4240 PSET (0,YSCALE)
  150. 4250 FOR I = 0 TO 639
  151. 4260 PY = YSCALE*(1- PL(I)): IF PY < 0 THEN PY = 0
  152. 4270 LINE -(I,PY)
  153. 4280 NEXT
  154. 4285 IF ITFLAG THEN LOCATE 24,2: PRINT TITLE$;
  155. 4287 IF IRFLAG THEN GOSUB 11500
  156. 4288 IF IRFLAG THEN PRINT "     Resolution:  ";: PRINT USING "##.## Hz"; DELNU
  157. 4290 BEEP
  158. 4300 GOTO 3140
  159. 5000 CLS:PRINT:PRINT"Routine to enter highest frequency to plot in PPM (left).":PRINT
  160. 5010 FU = FU/FR: PRINT"Current value: ";FU
  161. 5020 INPUT"Enter new value in PPM (or hit <Return> to keep old): ",FU$
  162. 5030 IF FU$ <> "" THEN FU = VAL(FU$)*FR ELSE FU = FU*FR
  163. 5040 GOTO 63999
  164. 6000 CLS:PRINT:PRINT"Routine to enter lowest frequency to plot in PPM (right).":PRINT
  165. 6010 FL = FL/FR: PRINT"Current value: ";FL
  166. 6020 INPUT"Enter new value in PPM (or hit <Return> to keep old): ",FL$
  167. 6030 IF FL$ <> "" THEN FL = VAL(FL$)*FR ELSE FL = FL*FR
  168. 6040 GOTO 63999
  169. 7000 CLS:PRINT:PRINT"Enter 'normalization' constant.  This must be between 0 and 1 for plot to be":PRINT" contained within the vertical scale.":PRINT
  170. 7010  PRINT"Current value: ";HF
  171. 7020 PRINT:INPUT"Enter new value (or hit <Return> to keep old): ",HFTEMP
  172. 7030 IF HFTEMP > 0 THEN HF = HFTEMP
  173. 7040 GOTO 63999
  174. 8000 X = 0
  175. 8010 FOR I = 0 TO 639
  176. 8020 IF X < PL(I) THEN X = PL(I)
  177. 8030 NEXT
  178. 8040 RETURN
  179. 9000 CLS:PRINT:PRINT"Routine to replot Lorentzian with new vertical scale.":         PRINT
  180. 9010 PRINT"Current scale factor:  ";HF: HFSAVE = HF
  181. 9020 PRINT:INPUT"Enter new scale factor (or hit <Return> to keep old): ",HF
  182. 9030 IF HF = 0 THEN HF = HFSAVE
  183. 9040 GOSUB 4210
  184. 9050 HF = HFSAVE
  185. 9060 RETURN
  186. 10000 CLS: PRINT:PRINT"Routine to enter a title to appear at bottom of spectrum.":PRINT
  187. 10010 PRINT"Enter title on next line.  It must be no longer than 78 characters."      :LINE INPUT "",TITLE$
  188. 10020 IF TITLE$ = "" THEN ITFLAG = 0 ELSE ITFLAG = 1
  189. 10030 RETURN
  190. 11000 CLS:PRINT:PRINT"Display ranges on plot? ";: GOSUB 600
  191. 11010 IF P$ = "N" THEN IRFLAG = 0: GOTO 63999
  192. 11020 IF P$ = "Y" THEN IRFLAG = 1 ELSE BEEP: GOTO 11000
  193. 11030 GOTO 63999
  194. 11500 LOCATE 2,2: PRINT USING " ####.##";FR;: PRINT " MHz       Range:  ";
  195. 11510 A = FU/FR: GOSUB 11600
  196. 11515 PRINT "- ";
  197. 11520 A = FL/FR: GOSUB 11600
  198. 11525 PRINT "PPM";
  199. 11530 RETURN
  200. 11600 IF A < 10 THEN PRINT USING "#.## ";A;
  201. 11610 IF A >= 10 AND A<100 THEN PRINT USING "##.## ";A;
  202. 11620 IF A >= 100 AND A<1000 THEN PRINT USING "###.## ";A;
  203. 11630 IF A >= 1000 THEN PRINT USING "####.## ";A;
  204. 11640 RETURN
  205. 20000 CLS:PRINT:PRINT"Routine to dump spectrum plot to disk for use by FFT program.":PRINT
  206. 20010 PRINT"NOTE:  YOU MUST HAVE PLOTTED THE SPECTRUM FOR THIS TO WORK!!!!!!!!":       PRINT
  207. 20020 PRINT"Has the spectrum been plotted?  ";: GOSUB 600
  208. 20030 IF P$ <> "Y" THEN PRINT "Generate spectrum and then return to this routine.": GOTO 63999
  209. 20040 PRINT:INPUT"Enter name of file to be used by FFT program:  ",OUTFILE$
  210. 20050 PRINT:PRINT"Now storing spectrum in file ";OUTFILE$
  211. 20060 OPEN OUTFILE$ FOR OUTPUT AS #1
  212. 20070 J = 10: PRINT #1, J
  213. 20080 J = 2^J - 1
  214. 20090 FOR I = 0 TO 639
  215. 20100 PRINT #1, PL(I)
  216. 20110 PRINT #1, 0!
  217. 20120 NEXT
  218. 20130 FOR I = 640 TO J
  219. 20140 PRINT #1, 0!
  220. 20150 PRINT #1, 0!
  221. 20160 NEXT
  222. 20170 CLOSE #1
  223. 20180 PRINT:PRINT "Plot now stored for use by FFT program."
  224. 20190 GOTO 63999
  225. 60000 PRINT: BEEP: PRINT"Error encountered!  Check that files needed have been read!": GOSUB 63999
  226. 60010 CLOSE 1
  227. 60020 RESUME 100
  228. 63999 IF IPFLAG = 1 THEN RETURN ELSE PRINT:INPUT"Hit <Return> to continue.",A$         :RETURN
  229.